home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / gnu / cvs-1_3.lha / cvs-1.3 / contrib / cln_hist.pl < prev    next >
Perl Script  |  1992-04-09  |  2KB  |  92 lines

  1. #!/usr/bin/perl --  # -*-Perl-*-
  2. #
  3. # cln_hist.pl,v 1.1 1992/04/10 03:04:15 berliner Exp
  4. # Contributed by David G. Grubbs <dgg@ksr.com>
  5. #
  6. # Clean up the history file.  10 Record types: MAR OFT WUCG
  7. #
  8. # WUCG records are thrown out.
  9. # MAR records are retained.
  10. # T records: retain only last tag with same combined tag/module.
  11. #
  12. # Two passes:  Walk through the first time and remember the
  13. #    1. Last Tag record with same "tag" and "module" names.
  14. #    2. Last O record with unique user/module/directory, unless followed
  15. #       by a matching F record.
  16. #
  17.  
  18. $r = $ENV{"CVSROOT"};
  19. $c = "$r/CVSROOT";
  20. $h = "$c/history";
  21.  
  22. eval "print STDERR \$die='Unknown parameter $1\n' if !defined \$$1; \$$1=\$';"
  23.     while ($ARGV[0] =~ /^(\w+)=/ && shift(@ARGV));
  24. exit 255 if $die;               # process any variable=value switches
  25.  
  26. %tags = ();
  27. %outs = ();
  28.  
  29. #
  30. # Move history file to safe place and re-initialize a new one.
  31. #
  32. rename($h, "$h.bak");
  33. open(XX, ">$h");
  34. close(XX);
  35.  
  36. #
  37. # Pass1 -- remember last tag and checkout.
  38. #
  39. open(HIST, "$h.bak");
  40. while (<HIST>) {
  41.     next if /^[MARWUCG]/;
  42.  
  43.     # Save whole line keyed by tag|module
  44.     if (/^T/) {
  45.     @tmp = split(/\|/, $_);
  46.     $tags{$tmp[4] . '|' . $tmp[5]} = $_;
  47.     }
  48.     # Save whole line
  49.     if (/^[OF]/) {
  50.     @tmp = split(/\|/, $_);
  51.     $outs{$tmp[1] . '|' . $tmp[2] . '|' . $tmp[5]} = $_;
  52.     }
  53. }
  54.  
  55. #
  56. # Pass2 -- print out what we want to save.
  57. #
  58. open(SAVE, ">$h.work");
  59. open(HIST, "$h.bak");
  60. while (<HIST>) {
  61.     next if /^[FWUCG]/;
  62.  
  63.     # If whole line matches saved (i.e. "last") one, print it.
  64.     if (/^T/) {
  65.     @tmp = split(/\|/, $_);
  66.     next if $tags{$tmp[4] . '|' . $tmp[5]} ne $_;
  67.     }
  68.     # Save whole line
  69.     if (/^O/) {
  70.     @tmp = split(/\|/, $_);
  71.     next if $outs{$tmp[1] . '|' . $tmp[2] . '|' . $tmp[5]} ne $_;
  72.     }
  73.  
  74.     print SAVE $_;
  75. }
  76.  
  77. #
  78. # Put back the saved stuff
  79. #
  80. system "cat $h >> $h.work";
  81.  
  82. if (-s $h) {
  83.     rename ($h, "$h.interim");
  84.     print "history.interim has non-zero size.\n";
  85. } else {
  86.     unlink($h);
  87. }
  88.  
  89. rename ("$h.work", $h);
  90.  
  91. exit(0);
  92.